home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: MegaDisc / MegaDisc 02 (1987)(MegaDisc Digital Publishing)(AU)[WB].zip / MegaDisc 02 (1987)(MegaDisc Digital Publishing)(AU)[WB].adf / PROGRAMS / jigsaw5 (.txt) < prev    next >
AmigaBASIC Source Code  |  1987-04-21  |  6KB  |  277 lines
  1. ' *** COMPUTE!'S AMAZING JIGSAW PROGRAM *** 
  2.  
  3. DEFINT a-z
  4. DEFSNG colrs
  5. DEF FNxyfmrc(cr,w)=(cr-1)*w
  6. DEF FNrcfmxy(xy,w)=INT((xy+w)/w)
  7.  
  8. false=0:true=-1
  9. ncols.pzl=5:nrows.pzl=4
  10. xmin.pzl=0:xmax.pzl=149:ymin.pzl=0:Move.piece=99
  11. xwidth=(xmax.pzl-xmin.pzl+1)/ncols.pzl
  12. ywidth=(Move.piece-ymin.pzl+1)/nrows.pzl
  13. getsize=3+INT((16+xwidth-1)/16)*ywidth*5
  14. rmin=1:rmax=7:cmin=1:cmax=10
  15. xmin=FNxyfmrc(cmin,xwidth)
  16. xmax=FNxyfmrc(cmax,xwidth)
  17. ymin=FNxyfmrc(rmin,ywidth)
  18. ymax=FNxyfmrc(rmax,ywidth)
  19. d=5:ncolrs=2^d-1:colrmin=2:colrmax=ncolrs-23
  20. vmin=1:vmax=3
  21.  
  22. DIM colrs(ncolrs,3),a(getsize,1),b(getsize)
  23. DIM pcol(ncols.pzl-1,nrows.pzl-1), prow(ncols.pzl-1,nrows.pzl-1)
  24. DIM cols(ncols.pzl*nrows.pzl-1), rows(ncols.pzl*nrows.pzl-1)
  25. DIM s$(ncols.pzl-1,nrows.pzl-1)
  26.  
  27. PALETTE 0,0,0.3,0.6
  28. PALETTE 1,1,1,0
  29.  
  30. s1$=STRING$(26,0)
  31. POKE SADD(s1$)+11,d
  32. POKE SADD(s1$)+15,xwidth
  33. POKE SADD(s1$)+19,ywidth
  34. POKE SADD(s1$)+21,24
  35. POKE SADD(s1$)+23,2^d-1
  36.  
  37. RESTORE Nu.Colors
  38. FOR i=0 TO ncolrs-1    'get new palette colours from DATA
  39.   FOR j=0 TO 2
  40.     READ colrs(i,j)
  41.   NEXT j
  42.   PALETTE i, colrs(i,0), colrs(i,1), colrs(i,2)
  43. NEXT i
  44.  
  45. RESTORE Cols.Rows
  46. FOR i=0 TO ncols.pzl*nrows.pzl-1
  47.   READ cols(i):READ rows(i)
  48. NEXT
  49.  
  50. SCREEN 1,320,200,d,1
  51. WINDOW 2,"JIGSAW",,28,1
  52.  
  53. Restart:
  54. CLS:RANDOMIZE TIMER:moves=0
  55.  
  56. p$="Press space bar to stop puzzle":LOCATE 23,20-INT(LEN(p$)/2):PRINT p$;
  57. WINDOW 3,"JIGSAW",(80,70)-(229,169),16,1
  58. PAINT (10,10),2
  59. GOSUB Make.Puzzle
  60. WINDOW OUTPUT 2
  61. LOCATE 23,20-INT(LEN(p$)/2):PRINT STRING$(LEN(p$)," ");
  62.  
  63. 'Make Bob strings and place pieces on the screen
  64. clast=ncols.pzl-1:rlast=nrows.pzl-1
  65.  
  66. '  ***  This was the start of the listing   ***
  67. FOR irow=0 TO rlast
  68.   FOR icol=0 TO clast
  69.     WINDOW OUTPUT 3
  70.     x=FNxyfmrc(icol+1,xwidth):y=FNxyfmrc(irow+1,ywidth)
  71.     GET (x,y)-(x+xwidth-1,y+ywidth-1),a(0,0)
  72.     s$(icol,irow)=""
  73.     ilast=getsize-1
  74.     FOR i=3 TO ilast:s$(icol,irow)=s$(icol,irow)+MKI$(a(i,0)):NEXT
  75.     WINDOW OUTPUT 2
  76.     i=icol+ncols.pzl*irow
  77.     x=FNxyfmrc(cols(i),xwidth):y=FNxyfmrc(rows(i),ywidth)
  78.     PUT (x,y),a(0,0)
  79.     pcol(icol,irow)=cols(i):prow(icol,irow)=rows(i)
  80.   NEXT
  81. NEXT
  82. WINDOW 2
  83.  
  84. '  Shuffle the pieces
  85. FOR i=0 TO 20
  86.   pick.rc:
  87.   FOR j=1 TO 2
  88.     col(j)=INT(ncols.pzl*RND):row(j)=INT(nrows.pzl*RND)
  89.   NEXT j
  90.   IF col(1)=col(2) AND row(1)=row(2) THEN GOTO pick.rc
  91.   FOR j=1 TO 2
  92.     x(j)=FNxyfmrc(pcol(col(j),row(j)),xwidth)
  93.     y(j)=FNxyfmrc(prow(col(j),row(j)),ywidth)
  94.     GET (x(j),y(j))-(x(j)+xwidth-1,y(j)+ywidth-1),a(0,j-1)
  95.     LINE (x(j),y(j))-(x(j)+xwidth-1,y(j)+ywidth-1),0,bf
  96.   NEXT j
  97.   PUT (x(1),y(1)),a(0,1):PUT (x(2),y(2)),a(0,0)
  98.   SWAP pcol(col(1),row(1)),pcol(col(2),row(2))
  99.   SWAP prow(col(1),row(1)),prow(col(2),row(2))
  100. NEXT
  101. '
  102. '  Main loop
  103. '
  104. t!=TIMER:ON TIMER (1) GOSUB Show.Time:TIMER ON
  105. done=false:selection.made=false
  106. GOSUB Beap
  107. WHILE NOT done
  108.   IF MOUSE(0)=-1 THEN
  109.     Select.Piece:
  110.     x=MOUSE(5):y=MOUSE(6) 'get x & y of mouse
  111.     GOSUB Fit2Scn  'see if on screen
  112.     col=FNrcfmxy(x,xwidth):row=FNrcfmxy(y,ywidth)
  113.     GOSUB WhatsThere
  114.     IF piece THEN
  115.       col.piece=cp:row.piece=rp
  116.       pcol(col.piece,row.piece)=-1
  117.       prow(col.piece,row.piece)=-1
  118.       GOSUB Beap
  119.       xp=FNxyfmrc(col,xwidth):yp=FNxyfmrc(row,ywidth)
  120.       xdif=xp-x:ydif=yp-y
  121.       GET (xp,yp)-(xp+xwidth-1,yp+ywidth-1),a(0,0)
  122.       LINE (xp,yp)-(xp+xwidth-1,yp+ywidth-1),0,bf
  123.       OBJECT.SHAPE 1,s1$+s$(col.piece,row.piece)
  124.       OBJECT.X 1,xp:OBJECT.Y 1,yp
  125.       OBJECT.ON 1
  126.       selection.made=true
  127.     END IF
  128.   END IF  '(mouse)
  129.   WHILE selection.made
  130.     WHILE MOUSE(0)=-1
  131.       x=MOUSE(5):y=MOUSE(6)
  132.       GOSUB Fit2Scn
  133.       IF x<>xp-xdif OR y<>yp-ydif THEN
  134.         xp=x+xdif:yp=y+ydif
  135.         OBJECT.X 1,xp:OBJECT.Y 1,yp
  136.       END IF
  137.     WEND
  138.  
  139.     GOSUB Fit2Scn
  140.     col=FNrcfmxy(x,xwidth)
  141.     row=FNrcfmxy(y,ywidth)
  142.     GOSUB WhatsThere
  143.     IF NOT piece THEN
  144.       x=FNxyfmrc(col,xwidth)
  145.       y=FNxyfmrc(row,ywidth)
  146.       OBJECT.OFF 1:PUT (x,y),a(0,0)
  147.       selection.made=false
  148.       pcol(col.piece,row.piece)=col
  149.       prow(col.piece,row.piece)=row
  150.       GOSUB Beap
  151.       moves=moves+1:LOCATE 23,13:PRINT"Moves:";moves;
  152.       r0=prow(0,0):c0=pcol(0,0):count=0
  153.       FOR r=0 TO nrows.pzl-1
  154.         FOR c=0 TO ncols.pzl-1
  155.           IF (prow(c,r)-r0)=r THEN 
  156.             IF (pcol(c,r)-c0)=c THEN count=count+1 
  157.           END IF
  158.       NEXT c,r
  159.       IF count=nrows.pzl*ncols.pzl THEN done =true
  160.     END IF   '(not piece)
  161.   WEND  '(selection)
  162. WEND  '(done)
  163. TIMER OFF
  164. FOR i=0 TO 10:GOSUB Beap:NEXT
  165. p$="Again (Y/N)?"
  166. COLOR 1,o:LOCATE 23,25:PRINT p$;
  167. p$="":FOR i=0 TO 1000:NEXT:WHILE p$="":p$=INKEY$:WEND
  168. IF p$="y" OR p$="Y" THEN GOTO Restart
  169. SCREEN CLOSE 1
  170. END
  171.  
  172. Beap:
  173. SOUND 800,1,100,0:SOUND 1000,1,100,0
  174. RETURN
  175.  
  176. Fit2Scn:
  177. IF x<xmin THEN x=xmin
  178. IF x>xmax THEN x=xmax
  179. IF y<ymin THEN y=ymin
  180. IF y>ymax THEN y=ymax
  181. RETURN
  182.  
  183. WhatsThere:
  184. piece=false:clast=ncols.pzl-1:rlast=nrows.pzl-1
  185. FOR c=0 TO clast
  186.   FOR r=0 TO rlast
  187.     IF pcol(c,r)=col THEN
  188.       IF prow(c,r)=row THEN piece=true:cp=c:rp=r:RETURN
  189.     END IF
  190.   NEXT
  191. NEXT
  192. RETURN
  193.  
  194. Make.Puzzle:
  195. FOR i=0 TO 1
  196.   x(i)=xmax.pzl*RND:y(i)=Move.piece*RND
  197.   v:
  198.   vx(i)=2*vmax*RND-vmax:vy(i)=2*vmax*RND-vmax
  199.   IF vx(i)=0 OR vy(i)=0 THEN GOTO v
  200. NEXT
  201. colr=colrmin
  202. WHILE INKEY$=""
  203.   FOR i= 0 TO 1
  204.     x(i)=x(i)+vx(i)
  205.     y(i)=y(i)+vy(i)
  206.     IF x(i)<=xmin.pzl OR x(i)>=xmax.pzl THEN
  207.       vx(i)=-SGN(vx(i))*(RND(vmax)+vmin)
  208.     END IF
  209.     IF y(i)<=ymin.pzl OR y(i)>=Move.piece THEN
  210.       vy(i)=-SGN(vy(i))*(RND(vmax)+vmin)
  211.     END IF
  212.   NEXT
  213.   colr=colr+1:IF colr>ncolrs-1 THEN colr=colrmin
  214.   LINE (x(0),y(0))-(x(1),y(1)),colr
  215. WEND
  216. RETURN
  217.  
  218. Show.Time:
  219. T2!=TIMER
  220. LOCATE 23,1:PRINT "Time:";CINT(T2!-t!);
  221. GOSUB Colr.Shift
  222. RETURN
  223.  
  224. Colr.Shift:
  225. FOR i=0 TO colrmax
  226.   IF i=colrmax THEN k=0 :ELSE k=i+1
  227.   FOR j=0 TO 2
  228.     colrs(i,j) = colrs(k,j)
  229.   NEXT j
  230.   PALETTE i, colrs(i,0), colrs(i,1), colrs(i,2)
  231. NEXT
  232. RETURN
  233.  
  234. Nu.Colors:
  235. DATA .00, .30, .60
  236. DATA .99, .60, .03
  237. DATA .59, .99, .03
  238. DATA .03, .55, .11
  239. DATA .03, .99, .81
  240. DATA .03, .51, .99
  241. DATA .50, .03, .50
  242. DATA .89, .03, .99
  243.  
  244. DATA .99, .03, .40
  245. DATA .25, .50, .50
  246. DATA .60, .00, .00 
  247. DATA .45, .30, .00
  248. DATA .99, .99, .00
  249. DATA .50, .00, .25
  250. DATA .00, .25, .25
  251. DATA .55, .00, .15
  252.  
  253. DATA .25, .25, .00
  254. DATA .45, .00, .00
  255. DATA .00, .30, .00
  256. DATA .75, .45, .00
  257. DATA .25, .25, .25
  258. DATA .00, .99, .00
  259. DATA .50, .25, .25
  260. DATA .99, .25, .00
  261.  
  262. DATA .50, .50, .25
  263. DATA .99, .00, .99
  264. DATA .55, .15, .40
  265. DATA .25, .00, .25
  266. DATA .70, .25, .00
  267. DATA .50, .50, .50
  268. DATA .75, .35, .30
  269. DATA .30, .20, .00
  270.  
  271.  
  272. Cols.Rows:
  273. DATA 1,1,  2,2,  1,3,  2,4,  1,5,  2,6,  1,7
  274. DATA 9,1, 10,2,  9,3,  10,4, 9,5,  10,6, 9,7
  275. DATA 3,1,  4,2,  5,1,  6,2,  7,1,  8,2
  276.  
  277.